home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / clisp-li.000 / clisp-li / clisp-1996-07-22 / src / trace.fas < prev    next >
Encoding:
CLISP byte-compiled Lisp program  |  1996-07-22  |  9.8 KB  |  209 lines
  1. (SYSTEM::VERSION '(19071996.))
  2. #Y(#:TOP-LEVEL-FORM-1 #17Y(00 00 00 00 00 00 00 00 00 01 D8 37 02 30 E4 19 01)
  3.    "LISP"
  4.   )
  5. #Y(#:TOP-LEVEL-FORM-2 #17Y(00 00 00 00 00 00 00 00 00 01 D8 37 01 30 DB 19 01)
  6.    (TRACE UNTRACE *TRACE-FUNCTION* *TRACE-ARGS* *TRACE-FORM* *TRACE-VALUES*)
  7.   )
  8. #Y(#:TOP-LEVEL-FORM-3 #17Y(00 00 00 00 00 00 00 00 00 01 D8 37 02 30 E4 19 01)
  9.    "SYSTEM"
  10.   )
  11. #Y(#:TOP-LEVEL-FORM-4 #15Y(00 00 00 00 00 00 00 00 00 01 D8 30 5E 19 01)
  12.    (SPECIAL *TRACE-FUNCTION* *TRACE-ARGS* *TRACE-FORM* *TRACE-VALUES*)
  13.   )
  14. #Y(#:TOP-LEVEL-FORM-5
  15.    #24Y(00 00 00 00 00 00 00 00 00 01 D8 30 5E D9 8B 53 04 D9 62 30 56 C4 19 01
  16.        )
  17.    (SPECIAL *TRACED-FUNCTIONS*) *TRACED-FUNCTIONS*
  18.   )
  19. #Y(#:TOP-LEVEL-FORM-6
  20.    #24Y(00 00 00 00 00 00 00 00 00 01 D8 30 5E D9 8B 53 04 D9 DA 30 56 C4 19 01
  21.        )
  22.    (SPECIAL *TRACE-LEVEL*) *TRACE-LEVEL* 0.
  23.   )
  24. #Y(#:TOP-LEVEL-FORM-7
  25.    #22Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 84 C3 19 01)
  26.    TRACE REMOVE-OLD-DEFINITIONS MACRO
  27.    #Y(TRACE
  28.       #62Y(00 00 00 00 01 00 01 00 00 08 94 02 92 00 05 D9 62 AC 1A 1D C3 19 04
  29.            AA 2E 03 1A 0E 93 00 9B 1F 76 AA 87 02 72 98 03 9C 36 00 14 83 02 16
  30.            01 82 00 9B 20 68 16 01 AA 30 A8 16 01 5C 19 04
  31.           )
  32.       *TRACED-FUNCTIONS* APPEND FUNCTION-NAME-P TRACE1
  33.   )  )
  34. #Y(#:TOP-LEVEL-FORM-8
  35.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01) TRACE1
  36.    REMOVE-OLD-DEFINITIONS
  37.    #Y(TRACE1
  38.       #532Y(00 00 00 00 01 00 00 00 80 1C 09 00 00 00 3C 09 3C 08 3C 07 3C 06
  39.             3C 05 3C 04 3C 03 3C 02 3C 01 37 01 71 92 37 01 71 92 B6 88 09 81
  40.             82 A7 1F 81 8A E9 EA E8 04 0F 5B 77 7A 02 60 02 14 7A 02 EB 62 EC
  41.             ED AE 7A 02 EE EF F0 E8 BF 7A 02 7A 04 03 19 7B 03 F2 F3 AF 7A 02
  42.             EE F4 F5 E8 C0 7A 02 7A 04 03 1E 7B 03 64 1F B1 64 20 B1 7A 02 7A
  43.             02 B1 64 21 B4 7A 02 7A 02 7A 02 EC 64 22 B4 64 23 B4 03 24 7B 02
  44.             7A 03 64 25 64 23 B4 03 26 7B 02 B6 7A 03 64 27 E8 C2 7A 02 03 28
  45.             7B 02 7A 04 64 29 63 64 2A B5 E8 65 19 7A 02 7A 05 64 2B 64 23 B4
  46.             03 2C 7B 02 E8 C2 7A 02 B7 64 25 64 23 B8 03 2D 7B 02 64 25 64 20
  47.             BA 7A 02 64 2E 65 1E 6E 2F 6F 30 64 31 64 32 64 33 EB 62 EC 65 23
  48.             03 34 7B 02 91 1D 80 DC 00 14 91 1C 80 E5 00 14 65 23 91 22 80 EC
  49.             00 14 64 32 64 38 64 36 64 39 65 2A 03 3A 7B 02 7A 02 7A 02 7A 01
  50.             91 24 80 DE 00 14 65 27 91 23 80 E2 00 14 91 25 80 EB 00 14 EC 65
  51.             2E 03 3C 7B 02 03 3D 79 32 03 23 79 32 02 23 7B 02 7A 01 32 02 23
  52.             79 32 03 23 7B 03 7A 03 7A 02 64 39 64 3E BF 7A 02 64 3F AE 64 40
  53.             64 41 64 42 64 43 64 44 64 45 E8 65 2A 7A 02 03 46 7B 02 7A 02 64
  54.             47 64 48 65 1D 7A 02 7A 02 7A 05 A1 7B 02 7A 03 64 49 64 4A 64 3F
  55.             B1 64 40 64 41 64 42 64 43 64 4B 64 47 64 4C 64 48 65 21 7A 02 7A
  56.             02 7A 02 7A 05 A4 7B 02 7A 03 7A 03 60 04 16 01 F6 7A 03 7A 03 7A
  57.             05 7A 05 E8 BD 7A 01 7A 02 60 06 19 0E E2 E3 E4 E5 6D 03 0E E7 B9
  58.             32 02 1F E8 A8 1A FE 7C 64 35 64 36 65 1F 7A 02 7A 02 60 01 1A FF
  59.             16 64 35 64 36 65 1E 7A 02 7A 02 60 01 1A FF 0D F2 65 23 03 37 7B
  60.             02 60 01 1A FF 09 F2 65 25 03 3B 7B 02 60 01 1A FF 17 64 35 64 36
  61.             65 25 7A 02 7A 02 60 01 1A FF 10 64 35 64 36 65 27 7A 02 7A 02 60
  62.             01 1A FF 07
  63.            )
  64.       :SUPPRESS-IF :STEP-IF :PRE :POST :PRE-BREAK-IF :POST-BREAK-IF :PRE-PRINT
  65.       :POST-PRINT :PRINT FUNCTION-NAME-P PROGRAM-ERROR
  66.       "~S: function name should be a symbol, not ~S"
  67.       "~S: Funktionsname sollte ein Symbol sein, nicht ~S"
  68.       "~S : Le nom de la fonction doit Ωtre un symbole et non ~S" LANGUAGE
  69.       TRACE QUOTE LOAD-TIME-VALUE GET-SETF-SYMBOL BLOCK UNLESS FBOUNDP WARN
  70.       (DEUTSCH "~S: Funktion ~S ist nicht definiert." ENGLISH
  71.         "~S: undefined function ~S" FRANCAIS
  72.         "~S : La fonction ~S n'est pas dΘfinie."
  73.       )
  74.       'TRACE ((RETURN NIL)) WHEN SPECIAL-FORM-P
  75.       (DEUTSCH "~S: Special-Form ~S kann nicht getraced werden." ENGLISH
  76.         "~S: cannot trace special form ~S" FRANCAIS
  77.         "~S : La forme spΘciale ~S ne peut pas Ωtre tracΘe."
  78.       )
  79.       'TRACE ((RETURN NIL)) LET* SYMBOL-FUNCTION CONSP EQ GET
  80.       ('TRACING-DEFINITION) SETF ('TRACED-DEFINITION) PUSHNEW
  81.       (*TRACED-FUNCTIONS* :TEST #'EQUAL) FORMAT
  82.       (DEUTSCH "~&;; ~:[Funktion~;Macro~] ~S wird getraced." ENGLISH
  83.         "~&;; Tracing ~:[function~;macro~] ~S." FRANCAIS
  84.         "~&;; Traτage ~:[de la fonction~;du macro~] ~S."
  85.       )
  86.       REPLACE-IN-FENV ('TRACED-DEFINITION) ('TRACING-DEFINITION) "TRACED-"
  87.       GET-FUNNAME-SYMBOL CONCAT-PNAMES
  88.       (DECLARE (COMPILE) (INLINE CAR CDR CONS APPLY VALUES-LIST)) LET
  89.       ((*TRACE-LEVEL* (TRACE-LEVEL-INC))) ((TRACE-PRE-OUTPUT)) TRACE-PRINT
  90.       MULTIPLE-VALUE-LIST ((BREAK-LOOP T)) *TRACE-VALUES* IF
  91.       ((TRACE-STEP-APPLY) (APPLY *TRACE-FUNCTION* *TRACE-ARGS*))
  92.       ((BREAK-LOOP T)) ((TRACE-POST-OUTPUT)) ((VALUES-LIST *TRACE-VALUES*)) NOT
  93.       FUNCTION LAMBDA &REST *TRACE-ARGS* &AUX *TRACE-FORM* MAKE-APPLY-FORM
  94.       (*TRACE-ARGS*) *TRACE-FUNCTION* GET-TRACED-DEFINITION CONS 'MACRO
  95.       (*TRACE-FORM* (CAR *TRACE-ARGS*)) CDR
  96.   )  )
  97. #Y(#:TOP-LEVEL-FORM-9
  98.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01)
  99.    REPLACE-IN-FENV REMOVE-OLD-DEFINITIONS
  100.    #Y(REPLACE-IN-FENV
  101.       #72Y(00 00 00 00 04 00 00 00 00 05 AE 8E 0D 04 AE 8E 0C 2C 00 19 05 14 71
  102.            4A D9 1A 1B AC AB 31 9A 5E 14 B1 8E 05 0B AC 9C 5E 14 A1 22 04 AE AD
  103.            9D 5F DA AB 81 02 35 00 AA AC 8E 04 60 00 19 08 AE D8 71 2F 91 00 50
  104.            00 19 06
  105.           )
  106.       5. 1. 2.
  107.   )  )
  108. #Y(#:TOP-LEVEL-FORM-10
  109.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01)
  110.    TRACE-LEVEL-INC REMOVE-OLD-DEFINITIONS
  111.    #Y(TRACE-LEVEL-INC #17Y(00 00 00 00 00 00 00 00 00 01 D8 6A 01 35 01 19 01)
  112.       #.#'1+ *TRACE-LEVEL*
  113.   )  )
  114. #Y(#:TOP-LEVEL-FORM-11
  115.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01)
  116.    GET-TRACED-DEFINITION REMOVE-OLD-DEFINITIONS
  117.    #Y(GET-TRACED-DEFINITION
  118.       #17Y(00 00 00 00 01 00 00 00 00 02 D8 AC D9 35 02 19 02) #.#'GET
  119.       TRACED-DEFINITION
  120.   )  )
  121. #Y(#:TOP-LEVEL-FORM-12
  122.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01)
  123.    TRACE-STEP-APPLY REMOVE-OLD-DEFINITIONS
  124.    #Y(TRACE-STEP-APPLY
  125.       #36Y(00 00 00 00 00 00 00 00 00 01 D8 D9 DA DB 6A 04 00 5C 79 DB 6A 05 00
  126.            5C 79 00 5C 5C 79 00 5C 79 35 01 19 01
  127.           )
  128.       #.#'EVAL STEP APPLY QUOTE *TRACE-FUNCTION* *TRACE-ARGS*
  129.   )  )
  130. #Y(#:TOP-LEVEL-FORM-13
  131.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01)
  132.    MAKE-APPLY-FORM REMOVE-OLD-DEFINITIONS
  133.    #Y(MAKE-APPLY-FORM
  134.       #41Y(00 00 00 00 02 00 00 00 00 03 AC 62 AD 1A 0D 93 00 D8 AB 00 5C 79 83
  135.            02 16 01 82 00 9B 20 70 16 01 AA 30 A8 16 01 5C 19 03
  136.           )
  137.       QUOTE
  138.   )  )
  139. #Y(#:TOP-LEVEL-FORM-14
  140.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01)
  141.    TRACE-PRE-OUTPUT REMOVE-OLD-DEFINITIONS
  142.    #Y(TRACE-PRE-OUTPUT
  143.       #42Y(00 00 00 00 00 00 00 00 00 01 D8 6A 01 35 01 DA 6A 03 DC 6A 01 DD DE
  144.            DF 63 35 07 E0 E1 6A 01 35 02 E2 6A 0B 6A 01 35 02 19 01
  145.           )
  146.       #.#'TERPRI *TRACE-OUTPUT* #.#'WRITE *TRACE-LEVEL* :STREAM :BASE 10.
  147.       :RADIX #.#'WRITE-STRING " Trace: " #.#'PRIN1 *TRACE-FORM*
  148.   )  )
  149. #Y(#:TOP-LEVEL-FORM-15
  150.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01)
  151.    TRACE-POST-OUTPUT REMOVE-OLD-DEFINITIONS
  152.    #Y(TRACE-POST-OUTPUT
  153.       #55Y(00 00 00 00 00 00 00 00 00 01 D8 6A 01 35 01 DA 6A 03 DC 6A 01 DD DE
  154.            DF 63 35 07 E0 E1 6A 01 35 02 E2 0E 0B 77 DC 6A 01 35 03 E4 E5 6A 01
  155.            35 02 6A 0E 62 2F 0F 19 01
  156.           )
  157.       #.#'TERPRI *TRACE-OUTPUT* #.#'WRITE *TRACE-LEVEL* :STREAM :BASE 10.
  158.       :RADIX #.#'WRITE-STRING " Trace: " #.#'WRITE *TRACE-FORM*
  159.       #.#'WRITE-STRING " ==> " *TRACE-VALUES* TRACE-PRINT
  160.   )  )
  161. #Y(#:TOP-LEVEL-FORM-16
  162.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01)
  163.    TRACE-PRINT REMOVE-OLD-DEFINITIONS
  164.    #Y(TRACE-PRINT
  165.       #56Y(00 00 00 00 01 00 01 00 00 08 3A 01 07 7D 01 92 01 0A 1A 03 92 01 05
  166.            D8 6A 01 35 01 9D 1F 16 1A 06 DB DC 6A 01 35 02 93 02 DA AB 6A 01 35
  167.            02 16 01 82 02 20 6C 00 19 03
  168.           )
  169.       #.#'TERPRI *TRACE-OUTPUT* #.#'PRIN1 #.#'WRITE-STRING ", "
  170.   )  )
  171. #Y(#:TOP-LEVEL-FORM-17
  172.    #22Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 84 C3 19 01)
  173.    UNTRACE REMOVE-OLD-DEFINITIONS MACRO
  174.    #Y(UNTRACE
  175.       #29Y(00 00 00 00 01 00 01 00 00 08 94 02 D8 D9 92 02 09 DB AD 60 02 14 60
  176.            03 19 04 C5 1A 78
  177.           )
  178.       MAPCAN #'UNTRACE1 (COPY-LIST *TRACED-FUNCTIONS*) QUOTE
  179.   )  )
  180. #Y(#:TOP-LEVEL-FORM-18
  181.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01) UNTRACE1
  182.    REMOVE-OLD-DEFINITIONS
  183.    #Y(UNTRACE1
  184.       #93Y(00 00 00 00 01 00 00 00 00 02 AB 88 00 14 AB 6E 07 AA E0 37 01 71 86
  185.            91 00 23 00 14 AE 2E 0F 15 19 04 D9 DA DB DC 6D 03 05 DE AE 32 02 1F
  186.            AA AE 9E 5D 14 AD 2C 04 0A AB AB 31 84 1A 1A AB 8C 54 0B 9C 5D 14 AC
  187.            E1 37 01 31 86 21 62 E3 E4 E5 6D 03 05 DE AF 2C 03 0E AD 60 01 1A FF
  188.            BE
  189.           )
  190.       FUNCTION-NAME-P PROGRAM-ERROR
  191.       "~S: function name should be a symbol, not ~S"
  192.       "~S: Funktionsname sollte ein Symbol sein, nicht ~S"
  193.       "~S : Le nom de la fonction doit Ωtre un symbole et non ~S" LANGUAGE
  194.       UNTRACE GET-FUNNAME-SYMBOL TRACED-DEFINITION TRACING-DEFINITION
  195.       REPLACE-IN-FENV "~S: ~S was traced and has been redefined!"
  196.       "~S: ~S war getraced und wurde umdefiniert!"
  197.       "~S : ~S Θtait tracΘe et a ΘtΘ redΘfinie!" WARN UNTRACE2
  198.   )  )
  199. #Y(#:TOP-LEVEL-FORM-19
  200.    #20Y(00 00 00 00 00 00 00 00 00 01 D8 2E 01 D8 DA 31 84 C3 19 01) UNTRACE2
  201.    REMOVE-OLD-DEFINITIONS
  202.    #Y(UNTRACE2
  203.       #36Y(00 00 00 00 01 00 00 00 00 02 AB 6E 00 AA D9 31 8B AA DA 31 8B 16 01
  204.            AB 6A 03 37 07 C7 F8 31 54 0F 03 19 02
  205.           )
  206.       GET-FUNNAME-SYMBOL TRACED-DEFINITION TRACING-DEFINITION
  207.       *TRACED-FUNCTIONS* #.#'EQUAL
  208.   )  )
  209.